Pascal Super Library/Pascal Super Library (CW International)(1997).bin/TSR/PPTSR10/TSRUTIL.PAS

Pascal/Delphi Source File | 1992-06-19 | 5KB | 262 lines

(*
 * help functions for tsr programming
 * from "DOS International" may 1992
 *)

unit tsrutil;

{$x-}

interface

const
  error : integer = 0;

  black     = 0; darkgray     =  8;
  blue      = 1; lightblue    =  9;
  green     = 2; lightgreen   = 10;
  cyan      = 3; lightcyan    = 11;
  red       = 4; lightred     = 12;
  magenta   = 5; lightmagenta = 13;
  brown     = 6; yellow       = 14;
  lightgray = 7; white        = 15;

  low       = 7;              (* low *)
  low_      = 1;              (* low, understrike *)
  lowb      = 135;            (* low, blinking *)
  low_b     = 129;            (* low, understrike, blinking *)
  high      = 15;             (* high *)
  high_     = 9;              (* high, understrike *)
  highb     = 140;            (* high, blinking *)
  high_b    = 137;            (* high, understrike, blinking *)
  inv       = 112;            (* inverse *)
  invb      = 240;            (* inverse, blinking *)
  invh      = 120;            (* inverse, high *)

  blink     = 128;            (* blinking *)

procedure savescreen( x,y,sx,sy : integer; var buffer );
procedure restorescreen( x,y,sx,sy : integer; var buffer );
procedure drawwindow( x,y,sx,sy : word; attr : byte );
procedure drawchar( x,y : word; attr : byte; c : char );
procedure drawstring( x,y : word; attr : byte; s : string );
procedure cursoroff;
procedure cursoron;

function  keyavail : boolean;
function  readkeycode : word;
procedure waitescret;

procedure getint( num : word; var vec : pointer );
procedure setint( num : word; vec : pointer );

implementation

var
  vseg    : word;
  cursize : word;
  curpos  : word;

(*
 * screen and string display functions
 *)

procedure savescreen( x,y,sx,sy : integer; var buffer ); assembler;
label
  l;
asm
  push  ds
  mov   cx,sx
  les   di,buffer
  mov   si,x
  dec   si
  shl   si,1
  mov   ax,160
  mov   dx,y
  dec   dx
  mul   dx
  add   si,ax
  mov   ds,vseg
  mov   dx,si
  mov   bx,sy
  mov   cx,sx
l:
  rep   movsw
  add   dx,160
  mov   si,dx
  mov   cx,sx
  dec   bx
  jnz   l
  pop   ds
end;

procedure restorescreen( x,y,sx,sy : integer; var buffer ); assembler;
label
  l;
asm
  push  ds
  mov   cx,sx
  lds   si,buffer
  mov   di,x
  dec   di
  shl   di,1
  mov   ax,160
  mov   dx,y
  dec   dx
  mul   dx
  add   di,ax
  mov   es,vseg
  mov   dx,di
  mov   bx,sy
l:
  rep   movsw
  add   dx,160
  mov   di,dx
  mov   cx,sx
  dec   bx
  jnz   l
  pop   ds
end;

procedure cursoroff; assembler;
asm
  xor   ax,ax
  mov   es,ax
  mov   di,460h         { $40:$60 cursor start and end line }
  mov   ax,es:[di]
  mov   cursize,ax
  mov   di,450h         { $40:$50 cursor position }
  mov   ax,es:[di]
  mov   curpos,ax
  mov   ax,0100h
  mov   cx,1f00h
  int   10h
end;

procedure cursoron; assembler;
asm
  mov   cx,cursize
  mov   ax,0100h
  int   10h
  mov   dx,curpos
  mov   ax,0200h
  sub   bx,bx
  int   10h
end;

procedure drawchar( x,y : word; attr : byte; c : char ); assembler;
asm
  mov   es,vseg
  mov   ax,y
  dec   ax
  mov   bx,160
  mul   bx
  mov   di,x
  dec   di
  shl   di,1
  add   di,ax
  mov   ah,attr
  mov   al,c
  stosw
end;

procedure drawstring( x,y : word; attr : byte; s : string );
var
  i : byte;
begin
  for i := 0 to length(s)-1 do
    drawchar( x+i, y, attr, s[i+1] );
end;

procedure drawwindow( x,y,sx,sy : word; attr : byte );
var
  i,j : byte;
begin
  drawchar( x,y,attr,'╔' );
  for i := 1 to sx-2 do
    drawchar( x+i,y,attr, '═' );
  drawchar( x+sx-1,y,attr,'╗' );
  for j := 1 to sy-2 do begin
    drawchar( x,y+j,attr,'║');
    for i := 1 to sx-2 do
      drawchar( x+i,y+j,attr,' ' );
    drawchar( x+sx-1,y+j,attr,'║' );
  end;
  drawchar( x,y+sy-1,attr,'╚' );
  for i := 1 to sx-2 do
    drawchar( x+i,y+sy-1,attr,'═' );
  drawchar( x+sx-1,y+sy-1,attr,'╝');
end;

(*
 * keyboard functions
 *)

function readkeycode : word; assembler;
asm
  mov   ah,0
  int   16h
end;

function keyavail : boolean; assembler;
label
  no, fin;
asm
  mov   ah,1
  int   16h
  jz    no
  mov   ax,1
  jmp   fin
no:
   sub  ax,ax
fin:
end;

procedure waitescret;
var
  code : word;
begin
  repeat
    code := readkeycode;
  until (code = $011b) or (code = $1c0d);
end;

procedure getint( num : word; var vec : pointer ); assembler;
asm
  mov   dx,ds
  sub   ax,ax
  mov   ds,ax
  mov   si,num
  shl   si,1
  shl   si,1
  les   di,vec
  cld
  movsw
  movsw
  mov  ds,dx
end;

procedure setint( num : word; vec : pointer ); assembler;
asm
  sub   ax,ax
  mov   es,ax
  mov   di,num
  shl   di,1
  shl   di,1
  cld
  mov   ax,word ptr [vec]
  stosw
  mov   ax,word ptr [vec+2]
  stosw
end;

begin
  case mem[$40:$49] of
    3 : vseg := $b800;
    7 : vseg := $b000;
    else
      writeln(^g'Unsupported video mode for unit TsrUtil.');
      exit;
   end;
end.